home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d27 / ddsgen.arc / DDSRPF02.RPG < prev    next >
Encoding:
Text File  |  1991-12-04  |  11.2 KB  |  142 lines
  1.      F********************************************************************      
  2.      F*                                                                  *      
  3.      F*  PGMID -        DDS01RPF02                                       *      
  4.      F*                                                                  *      
  5.      F*  FUNCTION -     GENERATE RECORD LEVEL PHYSICAL FILE DDS          *      
  6.      F*                                                                  *      
  7.      F*  AUTHOR -       TERRENCE W. MOYER                                *      
  8.      F*                 55 KEPPEL AVE.                                   *      
  9.      F*                 WEST LAWN, PA. 19609                             *      
  10.      F*                                                                  *      
  11.      F*  DATE -         NOV. 3, 1986                                     *      
  12.      F*                                                                  *      
  13.      F*  INDICATORS -   10  GENERAL PURPOSE, REUSABLE.                   *      
  14.      F*                                                                  *      
  15.      F*  NOTES -                                                         *      
  16.      F*                 SUPPORTED KEYWORDS                               *      
  17.      F*                 TEXT                                             *      
  18.      F*                 FORMAT (SUPPORTED BY INCLUDING THE FIELD         *      
  19.      F*                         DEFINITIONS OF THE REFERENCED            *      
  20.      F*                         FILE-FORMAT IN THE GENERATED DDS).       *
  21.      F*                                                                  *      
  22.      F********************************************************************      
  23.      FQADSPFFDIF  E                    DISK                           UC        
  24.      FSRCFIL  O   F      92            DISK                      A    UC        
  25.      E                    WRK        68  1               WORK ARRAY             
  26.      E                    WRK1       36  1               DDS FUNCT. FIELD       
  27.      I*  LDA WITH INPUT FILE AND SOURCE FILE INFORMATION                        
  28.      I           UDS                                                            
  29.      I                                        1  10 LINFL                       
  30.      I                                       11  20 LINLB                       
  31.      I                                       21  26 LINDT                       
  32.      I                                       27  32 LINTM                       
  33.      I                                       33  33 LINTYP                      
  34.      I                                       51 100 LINTXT                      
  35.      I                                      101 110 LSRCFL                      
  36.      I                                      111 120 LSRCLB                      
  37.      I                                      121 130 LSRCMB                      
  38.      I                                      201 2062LSRCSQ                      
  39.      I                                      207 2120LSRCDT                      
  40.      I* SOURCE SEQUENCE AND SOURCE DATE DS - WRITTEN TO DDS SRCFILE.
  41.      I            DS                                                            
  42.      I                                        1   62SRCSEQ                      
  43.      I                                        7  120SRCDAT                      
  44.      I* DDS SPECIFICATION - TO WRITE ACTUAL SPEC RECORDS TO DDS SRCFILE.        
  45.      IDSPEC       DS                                                            
  46.      I                                        1   5 DBLNK1                      
  47.      I                                        6   6 DSPECA                      
  48.      I                                        7  16 DBLNK2                      
  49.      I                                       17  17 DNMTYP                      
  50.      I                                       18  18 DBLNK3                      
  51.      I                                       19  28 DNAME                       
  52.      I                                       29  29 DREF                        
  53.      I                                       30  340DLEN                        
  54.      I                                       35  35 DDTYP                       
  55.      I                                       36  370DDEC                        
  56.      I                                       38  44 DBLNK4                      
  57.      I                                       45  80 DFUNC                       
  58.      I                                        1  80 DSPEC1                      
  59.      I                                        7  80 DSPEC2                      
  60.      C*------------------------------------------------------------------*
  61.      C*                         MAINLINE                                 *      
  62.      C*------------------------------------------------------------------*      
  63.      C* INITIALIZATION AND SETUP.                                               
  64.      C*                                                                         
  65.      C                     Z-ADDLSRCSQ    SRCSEQ           RETRIEVE SRCSEQ      
  66.      C                     Z-ADDLSRCDT    SRCDAT           AND SRCDAT.          
  67.      C                     MOVE 'A'       DSPECA           INIT. SPEC. DS.      
  68.      C*                                                                         
  69.      C                     OPEN SRCFIL                     OPEN FILES.          
  70.      C                     OPEN QADSPFFD                                        
  71.      C                     READ QADSPFFD                 10 GET RECRD.          
  72.      C*                                                                         
  73.      C*------------------------------------------------------------------*      
  74.      C*                   WRITE RECORD LEVEL KEYWORDS.                          
  75.      C*------------------------------------------------------------------*      
  76.      C*                                                                         
  77.      C*  WRITE RECORD FORMAT NAME AND RECORD TEXT IF NOT BLANK.                 
  78.      C                     MOVE 'R'       DNMTYP           BUILD DDS SPEC.      
  79.      C                     MOVE WHNAME    DNAME                                 
  80.      C*
  81.      C           WHTEXT    IFNE *BLANK                     BEGIN TEXT.          
  82.      C                     MOVEA'TEXT(''' WRK1             INIT FUNC ARRAY      
  83.      C                     Z-ADD+7        Y       40       AND INDEX.           
  84.      C                     MOVEAWHTEXT    WRK              FIND LENGTH OF       
  85.      C                     Z-ADD+50       X       40       FILE TEXT.           
  86.      C           WRK,X     DOWEQ' '                                             
  87.      C                     SUB  +1        X                                     
  88.      C                     END                                                  
  89.      C                     Z-ADDX         TXTLEN  40       SAVE LENGTH.         
  90.      C*  MOVE TEXT TO FUNCTION WORK ARRAY.                                      
  91.      C                     Z-ADD+1        X                FOR X = 1            
  92.      C           X         DOWLETXTLEN                     TO  TXTLEN DO        
  93.      C                     MOVE WRK,X     WRK1,Y           MOVE A CHAR.         
  94.      C                     ADD  +1        X                ADD TO INDEX.        
  95.      C                     ADD  +1        Y                                     
  96.      C           X         IFEQ +30                        CHECK FOR            
  97.      C                     MOVE '-'       WRK1,Y           CONTINUATION         
  98.      C                     MOVEAWRK1      DFUNC            LINES                
  99.      C                     MOVE DSPEC1    LINE   80                             
  100.      C                     EXSR @SRCLN                     WRITE THE
  101.      C                     MOVE *BLANK    WRK1             CONTINUATION         
  102.      C                     Z-ADD+1        Y                LINE.                
  103.      C                     MOVE *BLANK    DSPEC2                                
  104.      C                     END                             END CONTIUATION      
  105.      C                     END                             END DOWLE TXTL.      
  106.      C                     MOVEA''')'     WRK1,Y           MOVE IN END-         
  107.      C                     MOVEAWRK1      DFUNC            QUOTE AND PAREN.     
  108.      C                     MOVE DSPEC1    LINE             WRITE TEXT.          
  109.      C                     EXSR @SRCLN                                          
  110.      C                     MOVE *BLANK    DSPEC2                                
  111.      C                     ELSE                                                 
  112.      C                     MOVE DSPEC1    LINE             WRITE                
  113.      C                     EXSR @SRCLN                     FORMAT NAME.         
  114.      C                     END                             END TEXT IF.         
  115.      C*                                                                         
  116.      C* CLOSE FILES, PASS DATA, AND END PROGRAM.                                
  117.      C*                                                                         
  118.      C                     CLOSEQADSPFFD                                        
  119.      C                     CLOSESRCFIL                                          
  120.      C*
  121.      C                     Z-ADDSRCSEQ    LSRCSQ           PASS SRCSEQ          
  122.      C                     Z-ADDSRCDAT    LSRCDT           AND SRCDAT           
  123.      C                     SETON                       LR                       
  124.      C*                                                                         
  125.      C*------------------------------------------------------------------*      
  126.      C*       ADD TO SOURCE SEQUENCE NUMBER AND WRITE AN OUTPUT LINE            
  127.      C*------------------------------------------------------------------*      
  128.      C*                                                                         
  129.      C           @SRCLN    BEGSR                                                
  130.      C*                                                                         
  131.      C                     ADD  +1        SRCSEQ                                
  132.      C                     EXCPTSRCLIN                                          
  133.      C*                                                                         
  134.      C                     ENDSR                                                
  135.      C*------------------------------------------------------------------*      
  136.      C/SPACE 3                                                                  
  137.      OSRCFIL  EADD             SRCLIN                                           
  138.      O                         SRCSEQ     6                                     
  139.      O                         SRCDAT    12                                     
  140.      O                         LINE      92
  141. 
  142.